home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 2 / Amiga Tools 2.iso / tools / arexx-scripts / arexx-pack / rxview.lzh / rexxview.f < prev    next >
Encoding:
FORTH Source  |  1991-05-10  |  4.1 KB  |  226 lines
  1. \ RexxView by Martin Kees
  2. \ JForth REXX peeker
  3. \ CLI utility to monitor REXX message traffic
  4. \ Usage: rexxview outfile
  5. \ Terminate by sending: closerexxview to REXX port
  6. \ 3/JUN/91
  7. \ Freely Distributable
  8.  
  9.  
  10. getmodule includes
  11. getmodule arexxmod    \ arexx/storage.j arexx/rxslib.j
  12. include? addport()   ju:exec_support
  13. include? rexxsyslib? jrx:ArexxCalls.f
  14.  
  15. anew task_rexxview
  16.  
  17. 0 value rxpri
  18. 0 value myport
  19. 0 value rxport
  20. 0 value rmsg
  21. 0 value ofile
  22.  
  23. 1   RXFB_NOIO   <<  constant RXFF_NOIO
  24.  
  25. : FORBID() ( -- )
  26.     callvoid exec_lib forbid
  27. ;
  28.  
  29. : PERMIT() ( -- )
  30.     callvoid exec_lib permit 
  31. ;
  32.  
  33.  
  34. : dscanlist ( port -- rexxport true | 0 )
  35.   begin
  36.     s@ ln_succ dup
  37.     IF dup s@ ln_name ?dup
  38.       IF
  39.        RXSDIR 4 compare
  40.        IF-NOT true exit
  41.        THEN
  42.       THEN 
  43.     THEN
  44.     dup
  45.   until-not  
  46. ;
  47.  
  48. \ Not needed after I found that the message port list
  49. \ is priority sorted but ...
  50. : uscanlist ( port -- rexxport true | 0 )
  51.   begin
  52.     s@ ln_pred dup
  53.     IF dup s@ ln_name ?dup
  54.       IF
  55.        RXSDIR 4 compare
  56.        IF-NOT true exit
  57.        THEN
  58.       THEN
  59.     THEN
  60.     dup
  61.   until-not
  62. ;
  63.  
  64. : Openmyport ( -- flag )
  65.   0 -> myport
  66.   forbid()
  67.   RXSDIR findport() dup -> rxport
  68.   IF  rxport ..@ ln_pri -> rxpri
  69.       RXSDIR rxpri 1+ Createport() -> myport
  70.   THEN
  71.   permit()
  72.   myport
  73. ;
  74.  
  75. : Closemyport ( -- )
  76.   myport   ?dup IF deleteport()
  77.                    0 -> myport
  78.                 THEN
  79. ;
  80.  
  81. : msg>taskname ( msg -- 0$task )
  82.   s@ mn_replyport
  83.   s@ mp_SigTask
  84.   s@ ln_name
  85. ;
  86.  
  87. : msg>arg0 ( msg -- 0str )
  88.   .. rm_args @ >rel 
  89. ;
  90.  
  91. : fcr
  92.   10 pad c! ofile pad 1 fwrite drop
  93. ;
  94.  
  95.  
  96. : >ofile ( srt -- )
  97.   ofile swap count fwrite drop
  98. ;
  99.  
  100. : ?0type ( 0str str -- )
  101.   ofile swap count fwrite drop
  102.   0count
  103.   ?dup IF ofile -rot fwrite drop
  104.        ELSE drop ofile " Null" fwrite drop
  105.        THEN
  106.   fcr
  107. ;
  108.  
  109. : term.rv ( msg -- )
  110.    replymsg()
  111.    begin myport getmsg() ?dup
  112.    while replymsg()
  113.    repeat
  114.    closemyport
  115.    ofile fclose
  116. ;
  117.  
  118. : SendToRexx ( msg -- flag )
  119.   forbid()
  120.   myport dscanlist
  121.   ?dup IF-NOT  myport uscanlist
  122.        THEN
  123.   IF swap putmsg()   true
  124.   ELSE   false
  125.   THEN
  126.   permit()
  127.   IF-NOT
  128.      " REXX port closed!" >ofile
  129.      term.rv
  130.   THEN
  131. ;
  132.  
  133. : aboutmsg
  134.   ofile " RexxView by Martin Kees " count fwrite drop fcr
  135.   ofile " (c) 1991 M C Kees"        count fwrite drop fcr
  136.   ofile " Freely Distributable"     count fwrite drop fcr
  137. ;
  138.  
  139.  
  140. : .action ( msg -- )
  141.   " Action: " swap
  142.   ..@ rm_action  RXCODEMASK AND
  143. CASE
  144. RXCOMM   OF   0" RXCOMM"
  145.          ENDOF
  146. RXFUNC   OF   0" RXFUNC"
  147.          ENDOF
  148. RXCLOSE  OF   0" RXCLOSE"
  149.          ENDOF
  150. RXQUERY  OF   0" RXQUERY"
  151.          ENDOF
  152. RXADDFH  OF   0" RXADDFH"
  153.          ENDOF
  154. RXADDLIB OF   0" RXADDLIB"
  155.          ENDOF
  156. RXREMLIB OF   0" RXREMLIB"
  157.          ENDOF
  158. RXADDCON OF   0" RXADDCON"
  159.          ENDOF
  160. RXREMCON OF   0" RXREMCON"
  161.          ENDOF
  162. RXTCOPN  OF   0" RXTCOPN"
  163.          ENDOF
  164. RXTCCLS  OF   0" RXTCCLS"
  165.          ENDOF
  166.          0" UNKNOWN" swap
  167. ENDCASE
  168.     swap ?0type
  169. ;
  170.  
  171. : .modifier ( msg -- )
  172.   " Modifier: " >ofile
  173.   ..@ rm_action
  174.   dup RXFF_RESULT  and IF " RXFB_RESULT " >ofile
  175.                        THEN
  176.   dup RXFF_STRING  and IF " RXFB_STRING " >ofile
  177.                        THEN
  178.   dup RXFF_TOKEN   and IF " RXFB_TOKEN  " >ofile
  179.                        THEN
  180.   dup RXFF_NONRET  and IF " RXFB_NONRET " >ofile
  181.                        THEN
  182.   dup RXFF_NOIO    and IF " RXFB_NOIO   " >ofile
  183.                        THEN
  184.   drop fcr
  185. ;
  186.  
  187.  
  188.  
  189. : rexxview ( -- )
  190.   new fileword
  191.   dup 1+ c@ ascii ? = over c@ 0= OR
  192.   IF drop cr
  193.      ." Usage: rexxview  OutputFileName" cr
  194.      ." Terminate by sending to REXX: closerexxview"  cr
  195.      exit
  196.   THEN
  197.   $fopen -> ofile
  198.   ofile
  199.  IF
  200.   openmyport
  201.   IF aboutmsg
  202.     BEGIN
  203.      myport waitport() drop
  204.      myport getmsg() -> rmsg
  205.      rmsg msg>taskname " From Task: " ?0type
  206.      rmsg .action
  207.      rmsg .modifier
  208.      rmsg msg>arg0
  209.       dup " Arg0: " ?0type fcr
  210.        0" closerexxview" 0count compare
  211.        IF-NOT drop rmsg term.rv
  212.               quit
  213.        THEN
  214.      rmsg sendtorexx
  215.     AGAIN
  216.   ELSE ofile fclose
  217.        rxport IF-NOT ." REXX not found " cr exit
  218.               THEN
  219.   THEN
  220.   myport IF-NOT ." No memory for RexxView port!" cr exit
  221.          THEN
  222.  ELSE
  223.   ." Couldn't open output file" cr
  224.  THEN
  225. ;
  226.